meta %>%
filter(su_tract == 1) %>%
select(varname, about) %>% as.list()
## $varname
## [1] "census_tract" "year"
## [3] "conventional" "fha_insured"
## [5] "va_guaranteed" "usda_guaranteed"
## [7] "home_purchase" "home_improve"
## [9] "refinance" "cash_out_refi"
## [11] "other_purpose" "purposeNA"
## [13] "req_preapproval" "noreq_preapproval"
## [15] "originated_loan" "approvedApp_notAccepted"
## [17] "app_denied" "app_withdrawn"
## [19] "fileclosed_incomplete" "purchased_loan"
## [21] "denied_preapproval" "approve_preapproval"
## [23] "appRace_AIAN" "appRace_Asian"
## [25] "appRace_Black" "appRace_HawPI"
## [27] "appRace_White" "appRace_missing"
## [29] "appRace_NA" "appRace_multiracial"
## [31] "appEth_HisLat" "appMale"
## [33] "appFemale" "appsex_missing"
## [35] "avg_rateSpread" "highCost_mortgages"
## [37] "nonHighCost_mortgages" "firstlien_secured"
## [39] "sublien_secured" "avg_loan_amount"
## [41] "med_loan_amount" "avg_app_income"
## [43] "median_app_income" "median_income_accepted_app"
## [45] "white_denial_rate" "black_denial_rate"
## [47] "hislat_denial_rate" "loans_per_units"
## [49] "perc_conventional" "perc_govern_backed"
## [51] "sum_mortgage_dollars_in000s" "avg_homepurchase_loanamount"
## [53] "med_homepurchase_loanamount" "total_apps"
## [55] "perc_app_missingRace" "overall_denial_rate"
## [57] "perc_white_apps" "perc_black_apps"
## [59] "perc_hislat_apps" "population"
## [61] "minority_population" "median_family_income"
## [63] "tract_to_msamd_income" "tract_owner_occupied_units"
## [65] "tract_one_to_four_family_homes"
##
## $about
## [1] "11-digit tract code"
## [2] "The year"
## [3] "The number of conventional loans"
## [4] "The number of loans insured by the Federal Housing Administration"
## [5] "The number of VA guaranteed loans"
## [6] "The number of USDA guaranteed loans"
## [7] "The number of applications or covered loans for home purchase"
## [8] "The number of applications or covered loans for home improvement"
## [9] "The number of applications or covered loans for refinancing"
## [10] "The number of applications or covered loans for cash-out refinancing"
## [11] "The number of applications or covered loans for some other purpose"
## [12] "The number of applications or covered loans for a not applicable purpose"
## [13] "The number of applications or covered loans that requested preapproval of a home purchase loan under a preapproval program"
## [14] "The number of applications or covered loans that did not request preapproval of a home purchase loan under a preapproval program"
## [15] "The number of originated loans"
## [16] "The number of approved but not accepted applications"
## [17] "The number of denied applications"
## [18] "The number of applications withdrawn by the applicant"
## [19] "The number of application files closed for incompleteness"
## [20] "The number of purchased loans"
## [21] "The number of applications for which preapproval was denied"
## [22] "The number of applications for which preapproval request was approved but not accepted"
## [23] "The number of applicants who self-identified as American Indian or Alaska Native"
## [24] "The number of applicants self-identified as Asian including Asian Indian, Chinese, Filipino, Japanese, Korean, Vietnamese, or other Asian countries"
## [25] "The number of applicants who self-identified as Black"
## [26] "The number of applicants who self-identified as Native Hawaiian or Other Pacific Islander"
## [27] "The number of applicants who self-identified as White"
## [28] "The number of applicants who did not provide racial demographic information in their application by mal, internet, or telephone"
## [29] "The number of applicants for which racial identity is not applicable"
## [30] "The number of applicants who selected multiple racial identities"
## [31] "The number of applicants/borrower is Hispanic or Latino"
## [32] "The number of applicants who are male"
## [33] "The number of applicants who are female"
## [34] "The number of applicants who did not provide their sex on their application"
## [35] "The tract average of the difference between the covered loan's annual percentage rate (APR) and the average prime offer rate (APOR) for a comparable transaction as thee date of the interest rate is set"
## [36] "The number of covered loans that are high-cost mortgages"
## [37] "The number covered loans that are not a high cost mortgages"
## [38] "The number of covered loans/applications secured by the first lien"
## [39] "The number of covered loans/applications secured by a subordinate lien"
## [40] "The tract average loan amount. This variable seems prone to a high amount of entry error in the individual-level data, so users should be cautious about using the tract-level summary."
## [41] "The tract median loan amount. This variable seems prone to a high amount of entry error in the individual-level data, so users should be cautious about using the tract-level summary."
## [42] "The tract average applicant income. This variable seems prone to a high amount of entry error in the individual-level data, so users should be cautious about using the tract-level summary."
## [43] "The tract median applicant income. This variable seems prone to a high amount of entry error in the individual-level data, so users should be cautious about using the tract-level summary."
## [44] "The tract median income of accepted applications"
## [45] "The tract denial rate for white applicants"
## [46] "The tract denial rate for black applicants"
## [47] "The tract denial rate for Hispanic or Latino applicants"
## [48] "The number of loans per the number of one to four family homes in the tract"
## [49] "The percent of approved applications that were conventional"
## [50] "The percent of approved applications that were backed by the USDA, VA, or FHA"
## [51] "The total amount of the covered loans, or the amounts applied for in the tract"
## [52] "The tract average loan amount for originated loans"
## [53] "The tract median loan amount"
## [54] "The total number of applications in the tract"
## [55] "The percent of applications in which applicants did not disclose their racial identity"
## [56] "The tract denial rate for all applicants"
## [57] "The percent of applications in the tract from White applicants"
## [58] "The percent of applications from Black applicants"
## [59] "The percent of applications from Hispanic or Latino applicants"
## [60] "The population in the tract"
## [61] "The percentage of minority population to total ppulation for tract, rounded to two decimals places"
## [62] "The median family income in the tract"
## [63] "The percentage of tract median family income compared to MSA/MD median family income"
## [64] "The number of dwellings, including individual condominiums, that are lived in by the owner"
## [65] "The number of dwellings that are built to houses with fewer with than 5 families"
glimpse(eastdat)
## Rows: 164
## Columns: 65
## $ census_tract <dbl> 51001090100, 51001090100, 51001090100, …
## $ year <int> 2012, 2013, 2014, 2015, 2016, 2017, 201…
## $ conventional <int> 294, 319, 215, 213, 251, 244, 232, 220,…
## $ fha_insured <int> 5, 14, 8, 12, 11, 12, 24, 31, 33, 43, 4…
## $ va_guaranteed <int> 7, 11, 7, 16, 24, 15, 26, 28, 28, 31, 7…
## $ usda_guaranteed <int> 0, 0, 0, 2, 1, 0, 4, 9, 13, 9, 13, 12, …
## $ home_purchase <int> 68, 119, 117, 111, 140, 169, 70, 94, 12…
## $ home_improve <int> 9, 27, 13, 14, 14, 23, 18, 19, 27, 19, …
## $ refinance <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ cash_out_refi <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ other_purpose <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ purposeNA <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ req_preapproval <int> 4, 3, 8, 5, 4, 8, 0, 6, 8, 1, 5, 4, 1, …
## $ noreq_preapproval <int> 30, 43, 30, 11, 30, 19, 27, 26, 39, 9, …
## $ originated_loan <int> 157, 178, 122, 126, 159, 157, 137, 152,…
## $ approvedApp_notAccepted <int> 18, 19, 10, 7, 12, 5, 13, 9, 6, 9, 7, 8…
## $ app_denied <int> 57, 67, 57, 47, 41, 48, 56, 63, 69, 50,…
## $ app_withdrawn <int> 33, 24, 18, 22, 33, 27, 31, 21, 21, 31,…
## $ fileclosed_incomplete <int> 6, 13, 5, 7, 6, 11, 8, 5, 11, 17, 22, 1…
## $ purchased_loan <int> 35, 43, 18, 34, 36, 23, 41, 38, 35, 28,…
## $ denied_preapproval <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ approve_preapproval <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ appRace_AIAN <int> 2, 0, 0, 4, 2, 1, 0, 0, 0, 2, 2, 1, 0, …
## $ appRace_Asian <int> 0, 1, 1, 1, 3, 0, 1, 3, 2, 2, 4, 2, 0, …
## $ appRace_Black <int> 0, 2, 1, 2, 2, 2, 23, 23, 21, 20, 30, 2…
## $ appRace_HawPI <int> 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, …
## $ appRace_White <int> 239, 275, 201, 201, 226, 219, 207, 208,…
## $ appRace_missing <int> 42, 42, 17, 21, 31, 34, 37, 34, 36, 23,…
## $ appRace_NA <int> 22, 24, 10, 14, 23, 14, 18, 19, 16, 16,…
## $ appRace_multiracial <int> 1, 0, 0, 0, 0, 2, 0, 2, 0, 4, 2, 2, 0, …
## $ appEth_HispLat <int> 3, 2, 4, 3, 2, 5, 4, 3, 4, 1, 4, 6, 1, …
## $ appMale <int> 181, 211, 136, 141, 171, 153, 170, 176,…
## $ appFemale <int> 72, 81, 71, 74, 69, 82, 74, 78, 86, 63,…
## $ appsex_missing <int> 31, 28, 13, 14, 24, 22, 24, 15, 17, 18,…
## $ avg_rateSpread <dbl> 1.970000, 3.076250, 2.084000, 2.522857,…
## $ highCost_mortgages <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ nonHighCost_mortgages <int> 306, 344, 230, 243, 287, 271, 286, 288,…
## $ firstlien_secured <int> 263, 291, 203, 203, 242, 236, 234, 238,…
## $ sublien_secured <int> 6, 6, 4, 3, 3, 4, 6, 7, 5, 7, 7, 6, 0, …
## $ avg_loan_amount <dbl> 178254.90, 177002.91, 176769.57, 186308…
## $ med_loan_amount <dbl> 165.5, 164.5, 148.5, 177.0, 170.0, 155.…
## $ avg_app_income <dbl> 147693.95, 144394.23, 122276.79, 127519…
## $ median_app_income <dbl> 121000, 99500, 104000, 115000, 105000, …
## $ median_income_accepted_app <int> 134000, 107000, 109000, 120000, 117000,…
## $ white_denial_rate <dbl> 0.1882845, 0.2072727, 0.2537313, 0.2039…
## $ black_denial_rate <dbl> NA, 0.0000000, 0.0000000, 0.5000000, 0.…
## $ hislat_denial_rate <dbl> 0.6666667, 0.0000000, 0.2500000, 0.3333…
## $ loans_per_units <dbl> 0.0001263413, 0.0001274174, 0.000130616…
## $ perc_conventional <dbl> 98.08917, 94.94382, 93.44262, 89.68254,…
## $ perc_govern_backed <dbl> 1.910828, 5.056180, 6.557377, 10.317460…
## $ sum_mortgage_dollars_in000s <int> 27792, 31347, 21646, 22582, 30826, 2804…
## $ avg_homepurchase_loanamount <dbl> 186.22059, 177.82353, 178.70940, 181.45…
## $ med_homepurchase_loanamount <dbl> 164.0, 162.0, 143.0, 170.0, 177.0, 155.…
## $ total_apps <int> 306, 344, 230, 243, 287, 271, 286, 288,…
## $ perc_app_missingRace <dbl> 13.725490, 12.209302, 7.391304, 8.64197…
## $ overall_denial_rate <dbl> 0.1862745, 0.1947674, 0.2478261, 0.1934…
## $ perc_white_apps <dbl> 78.10458, 79.94186, 87.39130, 82.71605,…
## $ perc_black_apps <dbl> 0.0000000, 0.5813953, 0.4347826, 0.8230…
## $ perc_hislat_apps <dbl> 0.9803922, 0.5813953, 1.7391304, 1.2345…
## $ population <int> 2941, 2941, 2941, 2941, 2941, 2930, 615…
## $ minority_population <dbl> 6.02, 6.02, 6.02, 6.02, 6.02, 6.62, 36.…
## $ median_family_income <int> 52600, 51600, 52000, 52700, 52300, 5330…
## $ tract_to_msamd_income <dbl> 117.76, 117.76, 122.23, 122.23, 122.23,…
## $ tract_owner_occupied_units <int> 1323, 1323, 1323, 1323, 1323, 1095, 165…
## $ tract_one_to_four_family_homes <int> 4061, 4061, 4061, 4061, 4061, 4158, 343…
eastdat[which(eastdat$year == 2020),] %>% select(total_apps, overall_denial_rate, white_denial_rate, black_denial_rate, hislat_denial_rate, perc_conventional, perc_govern_backed) %>%
select(where(~is.numeric(.x))) %>%
as.data.frame() %>%
stargazer(., type = "text", title = "Summary Statistics", digits = 2,
summary.stat = c("mean", "sd", "min", "median", "max"))
##
## Summary Statistics
## ======================================================
## Statistic Mean St. Dev. Min Median Max
## ------------------------------------------------------
## total_apps 273.91 173.29 55 240 576
## overall_denial_rate 0.16 0.04 0.09 0.15 0.23
## white_denial_rate 0.16 0.04 0.10 0.15 0.26
## black_denial_rate 0.22 0.15 0.00 0.25 0.38
## hislat_denial_rate 0.12 0.14 0.00 0.06 0.36
## perc_conventional 75.99 7.70 65.22 74.42 90.40
## perc_govern_backed 24.01 7.70 9.60 25.58 34.78
## ------------------------------------------------------
longdat <- eastdat[which(eastdat$year == 2020),] %>% select(c(census_tract, total_apps, overall_denial_rate, white_denial_rate, black_denial_rate, hislat_denial_rate, perc_conventional, perc_govern_backed)) %>% pivot_longer(-census_tract, names_to = "measure", values_to = "value")
longdat$measure <- factor(longdat$measure,
levels = c("total_apps", "overall_denial_rate", "white_denial_rate", "black_denial_rate", "hislat_denial_rate", "perc_conventional", "perc_govern_backed"))
longdat %>%
ggplot(aes(x = value, fill = measure)) +
scale_fill_viridis(option = "plasma", discrete = TRUE, guide = FALSE) +
geom_histogram() +
facet_wrap(~measure, scales = "free")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 3 rows containing non-finite values (stat_bin).
meta %>%
filter(varname %in% c("total_apps", "overall_denial_rate", "white_denial_rate", "black_denial_rate", "hislat_denial_rate", "perc_conventional", "perc_govern_backed")) %>%
mutate(label = paste0(varname, ": ", about)) %>%
select(label) %>%
as.list()
$label [1] "white_denial_rate: The tract denial rate for white applicants"
[2] "black_denial_rate: The tract denial rate for black applicants"
[3] "hislat_denial_rate: The tract denial rate for Hispanic or Latino applicants"
[4] "perc_conventional: The percent of approved applications that were conventional"
[5] "perc_govern_backed: The percent of approved applications that were backed by the USDA, VA, or FHA" [6] "total_apps: The total number of applications in the tract"
[7] "overall_denial_rate: The tract denial rate for all applicants"
mapdat2020 <- mapdat[which(mapdat$year == 2020),]
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$total_apps)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$total_apps),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$census_tract, "<br>",
"Number of applications: ", mapdat2020$total_apps)
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$total_apps),
title = "Total number of <br>mortgage applications <br> in 2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_overall_denial_rate = mean(na.omit(overall_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat$avg_overall_denial_rate)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal(mapdat$avg_overall_denial_rate),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average overall app denial rate from 2007-2020: ", round(mapdat$avg_overall_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_overall_denial_rate),
title = "Average overall <br>app denial rate <br>from 2007-2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_white_denial_rate = mean(na.omit(white_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat$avg_white_denial_rate)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal(mapdat$avg_white_denial_rate),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average White app denial rate from 2007-2020: ", round(mapdat$avg_white_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_white_denial_rate),
title = "Average White <br>app denial rate <br>from 2007-2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_black_denial_rate = mean(na.omit(black_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = (mapdat$avg_black_denial_rate))
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal((mapdat$avg_black_denial_rate)),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average Black app denial rate from 2007-2020: ", round(mapdat$avg_black_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_black_denial_rate),
title = "Average Black <br>app denial rate <br>from 2007-2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_hislat_denial_rate = mean(na.omit(hislat_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = (mapdat$avg_hislat_denial_rate))
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal((mapdat$avg_hislat_denial_rate)),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average His/Lat app denial rate from 2007-2020: ", round(mapdat$avg_hislat_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_hislat_denial_rate),
title = "Average Hispanic/Latino <br>app denial rate <br>from 2007-2020", opacity = 0.7)
shape <- readRDS('eastshore_tracts.RDS')
shape <- shape %>% dplyr::rename(census_tract = GEOID)
animatemapdat <- merge(shape, eastdat, by = 'census_tract', all.x = T)
animatemapdat <- st_as_sf(animatemapdat)
animatemapdat$year = as.numeric(animatemapdat$year)
animatemapdat <- animatemapdat %>% filter_at(vars(NAME, geometry, perc_govern_backed),all_vars(!is.na(.)))
cville1 <-
ggplot(animatemapdat) +
geom_sf(aes(fill = perc_govern_backed), color = "black", alpha = .9, na.rm = TRUE) +
scale_fill_fermenter(palette = "Blues", direction = 1, type = "seq", n.breaks = 7) +
theme_void() +
guides(fill = guide_colourbar(title.position="top", title.hjust = 0.5, barwidth = 1)) +
labs(fill = "Percent of mortgages backed by gov.", title = 'Year:{frame_time}',
caption = "Percent of approved mortgage apps backed by the USDA, VA, or FHA") +
transition_time(as.integer(year)) +
ease_aes('linear')
animate(cville1, fps = 1, nframes = 13)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_percgovbacked = mean(na.omit(perc_govern_backed))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat$avg_percgovbacked)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal(mapdat$avg_percgovbacked),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average % of gov-backed mortgages <br> from 2006-2020: ", round(mapdat$avg_percgovbacked, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_percgovbacked),
title = "Average % of <br>gov-backed mortgages <br>from 2007-2020", opacity = 0.7)
mapdat2020 <- mapdat[which(mapdat$year == 2020),]
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$perc_govern_backed)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$perc_govern_backed),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$census_tract, "<br>",
"Percent of gov-backed <br>mortages in 2020: ", round(mapdat2020$perc_govern_backed, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$perc_govern_backed),
title = "Percent of <br>gov-backed <br>mortages in 2020", opacity = 0.7)